Ephedra californica recovery
Purpose
To explore Ephedra californica recovery following clipping. Year two in a long-term shrub removal experiment. Aboveground clipping. Panoche Hills Ecological Reserve.
Removal done by A. Liczner, A. Filazzola, T. Noble, and M. Westphal. Loss of shrub effects on animals experiment separate from this survey initiated by A. Liczner and completed 2016. Eva Gruber surveyed for resprouting.
Data
library(tidyverse)
library(plotly)
data <- read_csv("data/EH.recovery.2016.csv")
data## # A tibble: 40 × 8
## date census ID length width height resprout observations
## <chr> <chr> <int> <dbl> <dbl> <dbl> <int> <chr>
## 1 april.2013 pre.2 137 2.5 3.0 1.40 NA <NA>
## 2 april.2013 pre.2 146 4.4 3.8 1.50 NA <NA>
## 3 april.2013 pre.2 182 4.9 3.0 1.90 NA <NA>
## 4 april.2013 pre.2 183 4.3 3.3 1.70 NA <NA>
## 5 april.2013 pre.2 197 2.9 3.6 1.50 NA <NA>
## 6 april.2013 pre.2 200 1.9 1.2 0.70 NA <NA>
## 7 april.2013 pre.2 217 1.9 1.3 1.00 NA <NA>
## 8 april.2013 pre.2 245 4.3 4.6 1.28 NA <NA>
## 9 april.2013 pre.2 271 3.3 4.5 1.40 NA <NA>
## 10 april.2013 pre.2 273 2.6 0.3 1.30 NA <NA>
## # ... with 30 more rowsdata <- data %>% mutate(volume = ((length + width)/2)^3*3.14*(1/3)) %>% arrange(desc(resprout))
wet.weights <-read.csv("data/wet.weights.csv")
total.weight <- wet.weights %>% select(ID, total.weight)EDA
#current volume used####
#data viz
nov.2016 <- data %>% filter(date == "nov.2016") #only resurvey
nov.2016 <- left_join(nov.2016, total.weight, by = "ID")
p1 <- ggplot(nov.2016, aes(resprout, weight= volume)) +
geom_histogram(binwidth = 2, fill = "dodgerblue") +
xlab("number of shoots resprouted") +
ylab("relative weighted frequency by current volume")
ggplotly(p1)p1.1 <- ggplot(nov.2016, aes(ID, resprout)) +
geom_point(aes(size = volume), color = "dodgerblue")
ggplotly(p1.1)nov.2016 <- nov.2016 %>% filter(resprout < 15) #filter out my post hoc classifications
p2 <- ggplot(nov.2016, aes(volume, resprout)) +
geom_point(color = "dodgerblue") +
xlab("current shrub volume") +
ylab("number of resprouted shoots") +
geom_smooth(method = lm)
ggplotly(p2)p3 <- ggplot(nov.2016, aes(volume, total.weight)) +
geom_point(color = "dodgerblue") +
xlab("current shrub volume") +
ylab("total wet weight") +
geom_smooth(method = lm)
ggplotly(p3)#Detour, does number of resprouted shoots predict wet weight
p4 <- ggplot(nov.2016, aes(resprout, total.weight)) +
geom_point(color = "dodgerblue") +
xlab("resprouted shoot numbers") +
ylab("total wet weight") +
geom_smooth(method = lm)
ggplotly(p4)#quick test
fit <- lm(total.weight ~ resprout, data= nov.2016)
summary(fit)##
## Call:
## lm(formula = total.weight ~ resprout, data = nov.2016)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2127.08 -615.68 -99.73 1120.22 2763.02
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 594.48 738.92 0.805 0.4337
## resprout 189.05 95.54 1.979 0.0665 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1390 on 15 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.207, Adjusted R-squared: 0.1541
## F-statistic: 3.916 on 1 and 15 DF, p-value: 0.06649#simple main model
m1 <- glm(resprout ~ volume, data = nov.2016)
summary(m1)##
## Call:
## glm(formula = resprout ~ volume, data = nov.2016)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.9476 -1.9340 -0.7416 0.9654 7.2943
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.94757 0.97041 4.068 0.000895 ***
## volume 0.25031 0.06696 3.738 0.001793 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 8.557791)
##
## Null deviance: 256.50 on 17 degrees of freedom
## Residual deviance: 136.92 on 16 degrees of freedom
## AIC: 93.605
##
## Number of Fisher Scoring iterations: 2anova(m1, test = "Chisq")## Analysis of Deviance Table
##
## Model: gaussian, link: identity
##
## Response: resprout
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 17 256.50
## volume 1 119.58 16 136.93 0.0001855 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1m1.1 <- glm(total.weight ~ volume, data = nov.2016)
summary(m1.1)##
## Call:
## glm(formula = total.weight ~ volume, data = nov.2016)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2045.56 -437.74 -66.36 467.51 2879.01
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 887.75 414.97 2.139 0.04926 *
## volume 93.35 27.83 3.354 0.00435 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 1392680)
##
## Null deviance: 36559960 on 16 degrees of freedom
## Residual deviance: 20890205 on 15 degrees of freedom
## (1 observation deleted due to missingness)
## AIC: 292.61
##
## Number of Fisher Scoring iterations: 2anova(m1.1, test = "Chisq")## Analysis of Deviance Table
##
## Model: gaussian, link: identity
##
## Response: total.weight
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 16 36559960
## volume 1 15669755 15 20890205 0.0007956 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#setup volume####
setup <- data %>% filter(date == "april.2013") %>%
select(ID, volume) %>% rename(setup.vol = volume)
merged.data <- left_join(nov.2016, setup)
#repeat all above worflow code
p3 <- ggplot(merged.data, aes(resprout, weight= setup.vol)) +
geom_histogram(binwidth = 2, fill = "dodgerblue") +
xlab("number of shoots resprouted") +
ylab("relative weighted frequency by setup volume")
ggplotly(p3)p3.1 <- ggplot(merged.data, aes(total.weight, weight= setup.vol)) +
geom_histogram(binwidth = 1000, fill = "dodgerblue") +
xlab("total wet weight regrowth") +
ylab("relative weighted frequency by setup volume")
ggplotly(p3.1)p3.2 <- ggplot(merged.data, aes(ID, resprout)) +
geom_point(aes(size = setup.vol), color = "dodgerblue")
ggplotly(p3.2)merged.data <- merged.data %>% filter(resprout < 15) #filter out my post hoc classifications
p4 <- ggplot(merged.data, aes(setup.vol, resprout)) +
geom_point(color = "dodgerblue") +
xlab("setup shrub volume") +
ylab("number of resprouted shoots") +
geom_smooth(method = lm)
ggplotly(p4)p4.1 <- ggplot(merged.data, aes(setup.vol, total.weight)) +
geom_point(color = "dodgerblue") +
xlab("setup shrub volume") +
ylab("total wet weight regrowth") +
geom_smooth(method = lm)
ggplotly(p4.1)#simple model
m2 <- glm(resprout ~ setup.vol, data = merged.data)
summary(m2)##
## Call:
## glm(formula = resprout ~ setup.vol, data = merged.data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -4.989 -2.966 -1.361 2.726 6.840
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.78551 1.40967 3.395 0.0037 **
## setup.vol 0.05216 0.03352 1.556 0.1392
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 13.92356)
##
## Null deviance: 256.50 on 17 degrees of freedom
## Residual deviance: 222.78 on 16 degrees of freedom
## AIC: 102.37
##
## Number of Fisher Scoring iterations: 2anova(m2, test = "Chisq")## Analysis of Deviance Table
##
## Model: gaussian, link: identity
##
## Response: resprout
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 17 256.50
## setup.vol 1 33.723 16 222.78 0.1196m2.1 <- glm(total.weight ~ setup.vol, data = merged.data)
summary(m2)##
## Call:
## glm(formula = resprout ~ setup.vol, data = merged.data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -4.989 -2.966 -1.361 2.726 6.840
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.78551 1.40967 3.395 0.0037 **
## setup.vol 0.05216 0.03352 1.556 0.1392
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 13.92356)
##
## Null deviance: 256.50 on 17 degrees of freedom
## Residual deviance: 222.78 on 16 degrees of freedom
## AIC: 102.37
##
## Number of Fisher Scoring iterations: 2anova(m2.1, test = "Chisq")## Analysis of Deviance Table
##
## Model: gaussian, link: identity
##
## Response: total.weight
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 16 36559960
## setup.vol 1 698277 15 35861683 0.5889#Proportion regrowth by initial shrub size
merged.data <-merged.data %>% mutate(relative.regrowth = resprout/setup.vol) #calculate proportion reprouting by initial size
merged.data <-merged.data %>% mutate(relative.biomass.regrowth = total.weight/setup.vol) #calculate proportion reprouting by initial size
p5 <- ggplot(merged.data, aes(volume, relative.regrowth)) + geom_point(color = "dodgerblue") + xlab("current shrub volume") +
geom_smooth(method = lm) +
ylab("regrowth weighted by initial shrub size") +
scale_y_continuous(breaks=c(-2,-1,0,1,2))
ggplotly(p5)p5.1 <- ggplot(merged.data, aes(volume, relative.biomass.regrowth)) + geom_point(color = "dodgerblue") + xlab("current shrub volume") +
geom_smooth(method = lm) +
ylab("biomass regrowth weighted by initial shrub size") +
scale_y_continuous(breaks=c(-2,-1,0,1,2))
ggplotly(p5.1)m3 <- lm(merged.data$relative.regrowth ~ merged.data$volume)
summary(m3) # slope is not significantly different from 0 so no difference in proportionate regrowth##
## Call:
## lm(formula = merged.data$relative.regrowth ~ merged.data$volume)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.39398 -0.29158 -0.16772 -0.06767 1.91933
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.393979 0.206191 1.911 0.0741 .
## merged.data$volume 0.001213 0.014228 0.085 0.9331
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6216 on 16 degrees of freedom
## Multiple R-squared: 0.0004539, Adjusted R-squared: -0.06202
## F-statistic: 0.007266 on 1 and 16 DF, p-value: 0.9331anova(m3, test = "Chisq")## Analysis of Variance Table
##
## Response: merged.data$relative.regrowth
## Df Sum Sq Mean Sq F value Pr(>F)
## merged.data$volume 1 0.0028 0.00281 0.0073 0.9331
## Residuals 16 6.1818 0.38636m3.1 <- lm(merged.data$relative.biomass.regrowth ~ merged.data$volume)
summary(m3.1) # slope is not significantly different from 0 so no difference in proportionate regrowth##
## Call:
## lm(formula = merged.data$relative.biomass.regrowth ~ merged.data$volume)
##
## Residuals:
## Min 1Q Median 3Q Max
## -153.97 -109.28 -97.07 -26.06 1070.12
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 122.584 103.349 1.186 0.254
## merged.data$volume 1.980 6.931 0.286 0.779
##
## Residual standard error: 293.9 on 15 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.00541, Adjusted R-squared: -0.0609
## F-statistic: 0.0816 on 1 and 15 DF, p-value: 0.779anova(m3.1, test = "Chisq")## Analysis of Variance Table
##
## Response: merged.data$relative.biomass.regrowth
## Df Sum Sq Mean Sq F value Pr(>F)
## merged.data$volume 1 7049 7049 0.0816 0.779
## Residuals 15 1295773 86385Summary
Counting resprouted shoots is an effective and relatively accurate mechanism to estimate regrowth in Ephedra californica following damage. Trends in regrowth similar between shoot number and total wet weight and shoot number significantly and effectively predicts the mass of biomass regrowth per shrub.
Larger shrubs have more resprouted shoots and regrowth of biomass, however, the regrowth is not proportionately greater for increasingly larger shrubs. THIS is an important finding. Larger shrubs do NOT have a capacity to proportionally recover from damage relative to smaller shrubs.
Ephedra californica can recover to some extent following damage. However, we do not know how these recovery patterns compare to the background growth patterns of undamaged shrubs nor whether subsequent or repeated damages to this species reduces its potential capacity to recover.
Future directions. 1. Remeasure recovered in 1 and 2 years to this new clipping event. 2. Develop a means to estimate growth rate in undamaged shrubs for the next 1-2years.